home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v10n16.arc / HC.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-27  |  5KB  |  177 lines
  1. HC.PAS
  2.  
  3. {$A+,B-,D-,E-,F+,G-,I+,L-,N-,R-,S-,V-,X-}
  4. {$M 16384,0,0}
  5. PROGRAM HugeCalc;
  6. USES Calc;
  7. CONST Copyright : String[82] = 'HUGECALC 1.0, Copyright 1991 by '+
  8.   'Neil J. Rubenking'#13#10'PC Magazine '#254' Neil J. Rubenking';
  9.  
  10.   FUNCTION AllNums(VAR A : String) : Boolean;
  11.   VAR N : Byte;
  12.   BEGIN
  13.     AllNums := FALSE;
  14.     FOR N := 1 to length(A) DO
  15.       IF (A[N] < '0') OR (A[N] > '9') THEN Exit;
  16.     AllNums := TRUE;
  17.   END;
  18.  
  19.   FUNCTION IsDevice(VAR F : Text) : Boolean; Assembler;
  20.   ASM
  21.     MOV AH, 44h      {IOCTL function}
  22.     MOV AL, 00h      {get device info subfunction}
  23.     LES DI, F
  24.     MOV BX, ES:[DI]  {handle in BX}
  25.     INT 21h
  26.     MOV AL, 0        {return value is FALSE}
  27.     JC @end
  28.     TEST DX, 80h     {check is-device bit}
  29.     JZ @end          {if NOT set, just end}
  30.     INC AL           {return value is TRUE}
  31.     @end:
  32.   END;
  33.  
  34. VAR op, opRand, result, rem : String;
  35.     operation               : Char;
  36.  
  37.   FUNCTION GotParams : Boolean;
  38.     { PURPOSE : Returns true if parameters are
  39.       correctly passed on the command line -- and
  40.       assigns them to the correct variables if so.}
  41.   VAR S : String[1];
  42.       B : Byte;
  43.   BEGIN
  44.     GotParams := FALSE;
  45.     B := 2;
  46.     IF (NOT IsDevice(Input)) AND NOT EoF(Input) THEN
  47.       BEGIN
  48.         ReadLn(Op);
  49.         Dec(B);
  50.       END;
  51.     IF ParamCount < B THEN
  52.       BEGIN
  53.         WriteLn(Copyright);
  54.         WriteLn('Enter "HC ## op ##", ',
  55.                 'where op is +,-,*,/, or ^');
  56.         WriteLn('   or "HC ## !" for factorial');
  57.         Exit;
  58.       END;
  59.     IF B = 2 THEN op := ParamStr(1);
  60.     IF NOT AllNums(op) THEN
  61.       BEGIN
  62.         WriteLn(Copyright);
  63.         WriteLn('"',op,'" is not a positive integer.');
  64.         Exit;
  65.       END;
  66.     S := ParamStr(B);
  67.     operation := S[1];
  68.     CASE operation OF
  69.       '!' : ;
  70.       '+', '-', '*', '/', '^' : BEGIN
  71.         IF ParamCount < succ(B) THEN
  72.           BEGIN
  73.             WriteLn(Copyright);
  74.             WriteLn('The operator ',operation,
  75.                     ' requires a second operand.');
  76.             Exit;
  77.           END;
  78.         Oprand := ParamStr(B+1);
  79.         IF NOT AllNums(OpRand) THEN
  80.           BEGIN
  81.             WriteLn(Copyright);
  82.             WriteLn('"',oprand,'" is not a positive integer.');
  83.             Exit;
  84.           END;
  85.       END;
  86.       ELSE
  87.         BEGIN
  88.           WriteLn(Copyright);
  89.           WriteLn('Valid operations are +,-,*,/, ! and ^');
  90.           Exit;
  91.         END;
  92.     END;
  93.     GotParams := TRUE;
  94.   END;
  95.  
  96.   FUNCTION AddComma(WW : String) : String;
  97.   VAR posn, MinLoc : Word;
  98.   BEGIN
  99.     IF WW = '' THEN AddComma := '*ERROR*'
  100.     ELSE
  101.       BEGIN
  102.         posn := succ(length(WW));
  103.         MinLoc := 4;
  104.         IF WW[1] = '-' THEN Inc(MinLoc);
  105.         WHILE (posn > MinLoc) AND (length(WW) < 255) DO
  106.           BEGIN
  107.             Dec(posn, 3);
  108.             Move(WW[posn],
  109.                  WW[succ(posn)],
  110.                  succ(length(WW)-posn));
  111.             WW[posn] := ',';
  112.             Inc(WW[0]);
  113.           END;
  114.         AddComma := WW;
  115.       END;
  116.   END;
  117.  
  118. BEGIN
  119.   IF GotParams THEN
  120.     BEGIN
  121.       CASE operation OF
  122.         '+' : BEGIN
  123.                 IF IsDevice(Output) THEN
  124.                   Write('       SUM: ');
  125.                 result := add(op, opRand);
  126.                 IF IsDevice(Output) THEN
  127.                   WriteLn(AddComma(result))
  128.                 ELSE WriteLn(Result);
  129.               END;
  130.         '-' : BEGIN
  131.                 IF IsDevice(Output) THEN
  132.                   Write('DIFFERENCE: ');
  133.                 result := sub(op, opRand);
  134.                 IF IsDevice(Output) THEN
  135.                   WriteLn(AddComma(result))
  136.                 ELSE WriteLn(Result);
  137.               END;
  138.         '*' : BEGIN
  139.                 IF IsDevice(Output) THEN
  140.                   Write('   PRODUCT: ');
  141.                 result := prod(op, opRand);
  142.                 IF IsDevice(Output) THEN
  143.                   WriteLn(AddComma(result))
  144.                 ELSE WriteLn(Result);
  145.               END;
  146.         '/' : BEGIN
  147.                 IF IsDevice(Output) THEN
  148.                   Write(' QUOTIENT: ');
  149.                 result := divide(op, opRand, rem);
  150.                 IF IsDevice(Output) THEN
  151.                   BEGIN
  152.                     WriteLn(AddComma(result));
  153.                     Write('REMAINDER: ');
  154.                     WriteLn(AddComma(rem));
  155.                   END
  156.                 ELSE WriteLn(Result);
  157.               END;
  158.         '!' : BEGIN
  159.                 IF IsDevice(Output) THEN
  160.                   Write(' FACTORIAL: ');
  161.                 result := fact(op);
  162.                 IF IsDevice(Output) THEN
  163.                   WriteLn(AddComma(result))
  164.                 ELSE WriteLn(Result);
  165.               END;
  166.         '^' : BEGIN
  167.                 IF IsDevice(Output) THEN
  168.                   Write('     POWER: ');
  169.                 result := power(op, oprand);
  170.                 IF IsDevice(Output) THEN
  171.                   WriteLn(AddComma(result))
  172.                 ELSE WriteLn(Result);
  173.               END;
  174.       END;
  175.     END;
  176. END.
  177.